#!/usr/bin/perl
use strict;
use warnings;

BEGIN {
   # Sadly, Tcl.pm was not built for tk8.5, and a segmentation fault occurs 
   # whenever you "use Tcl;" because it tries to use tk8.4 stubs.  This can
   # be fixed in the Tcl.pm Makefile.PL, but such a change makes it harder
   # to share this program with others.  A second workaround is to set this
   # environment variable, which has solved the issue for me.
   $ENV{'PERL_DL_NONLAZY'} = 1;
}

use lib 'data/lib';
use lib 'data/extlib';
use Tkx;
use TkxPhotoRotateSimple;
use ChessLike::Game;
use ChessLike::Board;
use ChessLike::BoardUtils;
use ChessLike::Action;

=head1 NAME

Pawns-in-Space

=cut

my $BRANDING = 'Pawns-In-Space';

=head1 VERSION

Version 0.0.1

=head1 AUTHOR

Michael J. Lewis, C<< <mjlewis at ualberta.net> >>

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Michael J. Lewis.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

my $HOME_DIR = $ENV{'HOME'};
my $local_files_dir = "$HOME_DIR/.pawns_in_space";
my $open_games_dir = "$local_files_dir/open_games";
my $closed_games_dir = "$local_files_dir/closed_games";
my $prefs_path = "$local_files_dir/preferences";

my $data_dir = 'data';
my $rulesets_dir = "$data_dir/rulesets";
my $gamepieces_dir = "$data_dir/gamepieces";
my $graphics_dir = "$data_dir/gif";
my $debug_rulesets_dir = "$data_dir/d";

my ( $MOVE_PLAY_MODE, $ROTATION_PLAY_MODE,
 $LINK_PLAY_MODE ) = ( 0..2 );
my $game_mode = $MOVE_PLAY_MODE;

my %preferences = (
   'debug' => {
       'MODE' => 1,
   },
   'colors' => {
       'DARK-SQUARE'  => 'black',
       'LIGHT-SQUARE' => 'dark blue',
       'GRID'         => 'purple',
       'MOVE-VALID'   => 'yellow',
       'MOVE-INVALID' => 'grey',
       'MOVE-CAPTURE' => 'green',
       'MOVE-FIELD'   => 'blue',
       'SHOT-VALID'   => 'red',
       'SHOT-INVALID' => 'pink',
       'SELECTION'    => 'light blue',
   },
   'grid' => {
       'TILE-SIZE'      => 50,
       'STANDARD-WIDTH' => 1,
       'INVALID-WIDTH'  => 2,
       'VALID-WIDTH'    => 4,
   },
   'cursors' => {
       'STANDARD' => 'left_ptr',
       'MOVE'     => 'fleur',
       'SHOT'     => 'diamond_cross',
   },
);

my $top;  # toplevel GUI window
my $canvas;  # canvas where we draw the game board
my ( $L_MOUSE, $M_MOUSE, $R_MOUSE ) = ( 1, 2, 3 );

my $game;  # instance of ChessLike::Game
my $board;  # instance of ChessLike::Board
my ( $x_tiles, $y_tiles );  # number of ranks and files

my @available_rulesets;  # list of installed rulesets in $rulesets_dir
my @debug_rulesets;  # list of installed rulesets in $debug_rulesets_dir
my @open_games;  # list of open games in $open_games_dir
my @closed_games;  # list of closed games in $closed_games_dir

# Defines current selection during click/drag events, and caches
# drag events
my %selection = ();

# Keeps track of image IDs of enabled rotation arrows.  Used
# in &rotation_arrow_clicked().
my %image_for_rotation_arrow;

# Keeps track of link-selection-complete button
my $link_selection_complete_id;

# Stores link selector image IDs and link destination tiles
my %link_selector_data;

# Keeps track of all link-selection graphics, by tile
my %link_selector_graphics_at;

setup_environment();
create_gui();
Tkx::MainLoop();

###############################################################################

sub setup_environment {
   # Create any missing local directories
   foreach my $dir ( $local_files_dir, $open_games_dir, $closed_games_dir ) {
      if ( !( -e $dir ) ) {
         mkdir $dir or raise_error( "Can't create directory $dir: $!" );
      }
   }

   if ( -e $prefs_path ) {
      ## TODO:
      # Load preferences
   }
   else {
      ## TODO:
      # Create $prefs_path
   }

   # Read and store contents of each directory
   my %variable_for_dir = (
      "$rulesets_dir" => \@available_rulesets,
      "$debug_rulesets_dir" => \@debug_rulesets,
      "$open_games_dir" => \@open_games,
      "$closed_games_dir" => \@closed_games,
      );

   foreach my $dir ( keys %variable_for_dir ) {
      my $var = $variable_for_dir{$dir};

      opendir my $dh, $dir or raise_error( "Can't open directory $dir: $!" );
      # Grep for files that are not hidden
      @{ $var } = grep { !( -d $_ ) && ( $_ !~ m{\A \.}x ) } readdir( $dh );
      closedir $dh or raise_error( "Can't close directory $dir: $!" );
   }
}

sub create_gui {
   my $windowing_system = Tkx::tk_windowingsystem();
   print "Windowing system is $windowing_system\n";

   ### Main Window ###

   $top = Tkx::widget->new( "." );
   $top->g_wm_title( $BRANDING );
   $top->g_wm_geometry(
       ( $preferences{'grid'}->{'TILE-SIZE'} * 8 + 30 ) . 'x'
     . ( $preferences{'grid'}->{'TILE-SIZE'} * 8 + 30 ) . '+30+40' );

   ### Menus ###

   Tkx::option_add( "*tearOff", 0 );

   $top->configure(
       -menu => create_menus( $top ), );

   ### Canvas ###

   $canvas = $top->new_tk__canvas(
       -cursor => $preferences{'cursors'}->{'STANDARD'},
   );

   $canvas->g_grid(
      -column => 0,
      -row    => 0,
      -sticky => 'nesw',
      -padx   => 10,
      -pady   => 10, );
   $top->g_grid_columnconfigure( 0,
      -weight => 1 );
   $top->g_grid_rowconfigure( 0,
      -weight => 1 );

   ### Canvas Scrollbars ###
## TODO:
#   my $hscroll = $top->new_tk__scrollbar(
#      -orient => "horizontal",
#      -command => [$canvas, "xview"],
#      );
#   $hscroll->g_grid(-column => 0, -row => 1, -sticky => "we");
#
#   my $vscroll = $top->new_tk__scrollbar(
#      -orient => "vertical",
#      -command => [$canvas, "yview"],
#      );
#   $vscroll->g_grid(-column => 1, -row => 0, -sticky => "ns");

}

sub create_menus {
   my $top = shift;

   my $menubar = $top->new_menu();
   my $file_menu = $menubar->new_menu();
   my $new_game_menu = $file_menu->new_menu();
   my $edit_menu = $menubar->new_menu();
   my $debug_menu = $menubar->new_menu();
   my $debug_game_menu = $debug_menu->new_menu();
   
   ### File menu ###

   $menubar->add_cascade(
      -label     => "File",
      -underline => 0,
      -menu      => $file_menu,
      );

   $file_menu->add_cascade(
      -label => 'New',
      -underline => 0,
      -menu => $new_game_menu,
      );
   
   foreach my $ruleset_file ( @available_rulesets ) {
      # convert underscores to spaces, and remove trailing .cfg
      my $ruleset = $ruleset_file;
      $ruleset =~ s{_}{ };
      $ruleset =~ s{\.cfg\z}{};
      
      $new_game_menu->add_command(
            -label => $ruleset,
            -underline => 0,
            -command => sub { start_new_game( "$rulesets_dir/$ruleset_file" ) },
         );
   }

   $file_menu->add_command(
      -label => 'Load',
      -underline => 0,
      -accelerator => 'Ctrl+L',
      -command => \&nothing,
      );
   $top->g_bind( "<Control-l>", \&nothing );

   $file_menu->add_command(
      -label => 'Quit',
      -underline => 0,
      -accelerator => 'Ctrl+Q',
      -command => \&exit_program,
      );
   $top->g_bind( "<Control-q>", \&exit_program );

   ### Edit menu ###

   $menubar->add_cascade(
      -label     => "Edit",
      -underline => 0,
      -menu      => $edit_menu,
      );

   $edit_menu->add_command(
      -label => 'Preferences',
      -underline => 0,
      -accelerator => 'Ctrl+P',
      -command => \&nothing,
      );
   $top->g_bind( "<Control-p>", \&nothing );

   ### Debug menu ###

   if ( $preferences{'debug'}->{'MODE'} ) {
      $menubar->add_cascade(
         -label => 'Debug',
         -underline => 0,
         -menu => $debug_menu,
         );

      $debug_menu->add_command(
         -label => 'Clear Canvas',
         -underline => 0,
         -accelerator => 'Ctrl+Shift+C',
         -command => \&clear_canvas,
         );
      $top->g_bind( "<Control-C>", \&clear_canvas );

      $debug_menu->add_cascade(
         -label => 'New',
         -underline => 0,
         -menu => $debug_game_menu,
         );

      foreach my $ruleset_file ( @debug_rulesets ) {
         # convert underscores to spaces, and remove trailing .cfg
         my $ruleset = $ruleset_file;
         $ruleset =~ s{_}{ };
         $ruleset =~ s{\.cfg\z}{};
      
         $debug_game_menu->add_command(
            -label => $ruleset,
            -underline => 0,
            -command => sub {
                  start_new_game( "$debug_rulesets_dir/$ruleset_file" );
               },
            );
      }

   }

   sub nothing { print "Menu Activated!\n" }

   return $menubar;
}

sub start_new_game {
    my $ruleset_path = shift;

    # We define some graphical functions that our $board will hook into
    my %function_for = (
        'move-graphic' => sub {
            my %params = @_;
            my $graphic = $params{'graphic'};
            my ( $canvas_x, $canvas_y )
                = tile_xy_to_coords(
                    @params{'target-tile-x', 'target-tile-y'} );
            my ( $target_index, $tile, $target_tile )
                = @params{'target-index', 'tile', 'target-tile' };

            # Move the graphic
            $canvas->coords( $graphic, $canvas_x, $canvas_y );

            # Determine if the graphic should be placed above or below
            # other units on the target tile
            if ( $target_index == 0 ) {
                $canvas->raise( "occupies-$target_tile", $graphic );
            }
            else {
                $canvas->raise( $graphic, "occupies-$target_tile" );
            }

            # Update tile tag on graphic
            $canvas->dtag( $graphic, "occupies-$tile" );
            $canvas->addtag( "occupies-$target_tile", 'withtag', $graphic );
        },
        
        'delete-graphic' => sub {
            my %params = @_;
            $canvas->delete( $params{'graphic'} );
        },
        
        'rotate-graphic' => sub {
            my %params = @_;
            my ( $graphic, $target_direction )
                = @params{'graphic', 'target-direction'};

            my $image = $canvas->itemcget( $graphic, '-image' );
            $image =~ s{-[nsew]$}{-$target_direction};
            
            $canvas->itemconfigure(
                $graphic,
                -image => $image );
        },
    );

    eval {
        $game = ChessLike::Game->new();
        $board = ChessLike::Board->parse( $ruleset_path, $gamepieces_dir );
        ( $x_tiles, $y_tiles ) = ( $board->x_tiles(), $board->y_tiles() );
        $board->set_move_graphic_hook( $function_for{'move-graphic'} );
        $board->set_delete_graphic_hook( $function_for{'delete-graphic'} );
        $board->set_rotate_graphic_hook( $function_for{'rotate-graphic'} );
    };
    raise_error( $@ ) if $@;
    
    clear_canvas();
    draw_board();
    draw_gamepieces();
    draw_rotation_arrows();
    draw_link_selectors();
}

sub clear_canvas {
    $canvas->delete( 'game-items' );
}

sub draw_board {
   for ( my $i = 0; $i < $y_tiles; $i++ ) {
      my @row;

      for ( my $j = 0; $j < $x_tiles; $j++ ) {
         my $even_or_odd = ( $i + $j ) % 2 ? 'tiles-even' : 'tiles-odd';
         
         # We have to account for differences in grid numbering: Chess grids
         # are numbered using cartesian coordinates, whereas the canvas widget
         # reverses the directionality of the y-axis.
         my $coords = ( $j + 1 ) . ',' . ( $y_tiles - $i );
         my $tile = $board->convert( $coords, 'tile' );
         
         # Draw the square.  The "+1"s are in there for aesthetic
         # purposes.  Without them, the top and left sides of the
         # board are borderless.
         my $id = $canvas->create_rectangle(
            $j*$preferences{'grid'}->{'TILE-SIZE'} + 1,
            $i*$preferences{'grid'}->{'TILE-SIZE'} + 1,
            ($j + 1)*$preferences{'grid'}->{'TILE-SIZE'} + 1,
            ($i + 1)*$preferences{'grid'}->{'TILE-SIZE'} + 1,
            -tags  => [ 'tiles', $even_or_odd, 'game-items', $tile ],
            -outline => $preferences{'colors'}->{'GRID'},
            );
      }
   }

   paint_tiles();
}

sub paint_tiles {
   # The even/odd designation refers to tile ID, which begins with 0.
   $canvas->itemconfigure( 'tiles-even',
      -fill => $preferences{'colors'}->{'DARK-SQUARE'} );
   $canvas->itemconfigure( 'tiles-odd',
      -fill => $preferences{'colors'}->{'LIGHT-SQUARE'} );

   $canvas->itemconfigure( 'move-field',
      -fill => $preferences{'colors'}->{'MOVE-FIELD'} );
   $canvas->itemconfigure( 'move-invalid',
      -outline => $preferences{'colors'}->{'MOVE-INVALID'},
      -width   => $preferences{'grid'}->{'INVALID-WIDTH'}, );
   $canvas->itemconfigure( 'shot-invalid',
      -outline => $preferences{'colors'}->{'SHOT-INVALID'},
      -width   => $preferences{'grid'}->{'INVALID-WIDTH'}, );

   $canvas->itemconfigure( 'move-valid',
      -outline => $preferences{'colors'}->{'MOVE-VALID'},
      -width   => $preferences{'grid'}->{'VALID-WIDTH'}, );
   $canvas->itemconfigure( 'shot-valid',
      -outline => $preferences{'colors'}->{'SHOT-VALID'},
      -width   => $preferences{'grid'}->{'VALID-WIDTH'}, );
   $canvas->itemconfigure( 'capture-valid',
      -outline => $preferences{'colors'}->{'MOVE-CAPTURE'},
      -width   => $preferences{'grid'}->{'VALID-WIDTH'}, );

   foreach my $tag ( 'move-invalid', 'shot-invalid',
    'move-valid', 'shot-valid', 'capture-valid' ) {

      $canvas->raise( $tag, 'tiles' );
   }
}

sub reset_tile_colors {

   foreach my $tag ( 'move-valid', 'move-invalid',
    'move-field', 'capture-valid',
    'shot-valid', 'shot-invalid' ) {

      $canvas->itemconfigure( $tag,
         -outline => $preferences{'colors'}->{'GRID'},
         -width   => $preferences{'grid'}->{'STANDARD-WIDTH'}, );
       
       $canvas->dtag( $tag, $tag );
   }

   paint_tiles();
}

sub draw_gamepieces {
   my $iterator;
   eval {
      $iterator = find_tile_contents( $board );
   };
   raise_error( $@ ) if $@;
   
   my %seen_gamepiece;  # To make sure we only process each graphic once

   # For units that can rotate
   my %angle_for_direction = (
       'e' => -90,
       's' => 180,
       'w' => 90,
   );
   
   while ( my ( $tile, $index, $gamepiece, $team, $direction, $graphic )
       = next_tile_contents( $iterator, 'gamepiece', 'team', 'direction',
            'graphic' ) ) {
       
      # Note that the iterator will return gamepieces in order of index,
      # so fliers will always be drawn after ground units that occupy the
      # same tile.  That makes things easy!
      
      my ( $x, $y ) = split m{,}, $board->convert( $tile, 'xy' ), 2;
      my ( $canvas_x, $canvas_y ) = tile_xy_to_coords( $x, $y );
      
      # Raw name is simply the gamepiece name without spaces.
      # Root name adds flip-code suffixes for flying units.
      # Name (defined later) adds coloring to Root name.
      my $raw_name = $gamepiece->name();
      $raw_name =~ s{ }{}g;
      my $root_name = $raw_name;

      # For aesthetics, since flying units can overlap, we flip
      # the graphics based on team and starting tile ID.  The flip
      # axis is determined by a unit's 'flip code'.
      # Note that the flip code for ground units is undefined.
      my %flip_axis_for = (
          '1L' => 'y',  # player1, left
          '1R' => undef,  # player1, right
          '2L' => 'xy',  # player 2, left
          '2R' => 'x',  # player2, right
      );
      my ( $flip_code, $flip_axis );
      
      if ( $gamepiece->is_flying() ) {
          if ( $x % 2 == 0 ) {
              $flip_code = $team.'R';
          }
          else {
              $flip_code = $team.'L';
          }
          $root_name .= ".$flip_code";
          $flip_axis = $flip_axis_for{$flip_code};  # may be undef
      }

      # Here we define which graphic files to process.
      my @colorings = ( "-P$team", '-selected' );

      foreach my $coloring ( @colorings ) {
          my $name = $root_name . $coloring;
          
          # Bail if we've already processed this graphic
          next if ( $seen_gamepiece{$name} );
          
          # Note that we use the Raw name here, since the L/R
          # flipping is done programatically, and therefore is not
          # part of the graphic filename.
          my $graphic_path = "$graphics_dir/$raw_name$coloring.gif";
          if ( !( -e $graphic_path ) ) {
              print "ERROR: Graphic path [$graphic_path] not found!\n";
          }

          # Here we flip flying units, which are the only units with a
          # defined flip axis.
          if ( defined $flip_axis ) {
              # We need to have the unflipped image in order to
              # create the flipped image.
              Tkx::image_create_photo( 'unflipped-temporary',
                                       -file => $graphic_path );
              
              # Yeah, even though we are doing some flipping,
              # by convention all non-rotating units face north
              TkxPhotoRotateSimple::simple_photo_flip(
                  'unflipped-temporary', "$name-$direction", $flip_axis );
          }

          # TODO: We have a small problem here.  If we try to process
          # a flying unit that can rotate, we'll run into 'image-already-exists'
          # errors.
          
          # Here we deal with rotating units.
          # All graphics are oriented north by default.  For all
          # other directions we use north as a starting point
          # and rotate the image.
          if ( $gamepiece->can_rotate() ) {
              Tkx::image_create_photo( "$name-n",
                                       -file => $graphic_path, );
              
              foreach my $rotation ( 'e', 's', 'w' ) {
                  TkxPhotoRotateSimple::simple_photo_rotate(
                      "$name-n", "$name-$rotation",
                      $angle_for_direction{$rotation},
                  );
              }
          }
          
          # Now we deal with all the remaining units.
          if ( !defined $flip_axis && !$gamepiece->can_rotate() ) {
              Tkx::image_create_photo( "$name-$direction",
                                   -file => $graphic_path );
          }
          
          $seen_gamepiece{$name} = 1;
      }
      
      my $id = $canvas->create_image(
         $canvas_x, $canvas_y,
         -image => "$root_name-P$team-$direction",
         -tags  => [ 'gamepieces', 'game-items', "occupies-$tile" ],
      );
      
      # Add the image to the board, so that we can access
      # the graphic via the gamepiece.
      $board->configure( $tile, $index, 'graphic' => $id );
   }
   
   $canvas->bind( 'gamepieces', "<Button>",
      [ \&gamepiece_clicked, Tkx::Ev( "%b", "%x", "%y" ) ] );
   $canvas->bind( 'gamepieces', "<Shift-Button>",
      [ \&gamepiece_mod_clicked, Tkx::Ev( "%x", "%y" ) ] );
   
   $canvas->bind( 'gamepieces', "<Motion>",
      [ \&gamepiece_dragged, Tkx::Ev( "%x", "%y" ) ] );
   
   $canvas->bind( 'gamepieces', "<ButtonRelease>",
      [ \&gamepiece_released, Tkx::Ev( "%b", "%x", "%y" ) ] );
}

sub draw_rotation_arrows {
    my %angle_for_direction = (
        'e' => -90,
        's' => 180,
        'w' => 90,
    );
    
    # TODO: foreach my $type ( 'enabled', 'disabled', 'selected' ) {
    foreach my $type ( 'enabled', 'disabled' ) {
        my $arrow_name = "Arrow-$type";
        my $graphic_path = "$graphics_dir/$arrow_name.gif";

        die "Graphic [$graphic_path] not found!"
            if ( !( -e $graphic_path ) );

        Tkx::image_create_photo( "$arrow_name-n",
                                 -file => $graphic_path );
        
        my $id = $canvas->create_image(
            50, 50,  # Arbitrary values
            -image => "$arrow_name-n",
            -tags  => [ 'rotation-arrows', 'game-items',
                    "$arrow_name-n" ],
        );

        # TODO: This conditional is only necessary if I commit to
        # not using 'selected' arrows
        if ( $type eq 'enabled' || $type eq 'disabled' ) {
            $canvas->bind( $id, "<Button>",
                [ \&rotation_arrow_clicked,
                  Tkx::Ev( "%x", "%y" ) ] );
        }

        # This is for keeping track of our enabled arrow IDs,
        # so that we can query them later (se
        # &rotation_arrow_clicked())
        if ( $type eq 'enabled' ) {
            $image_for_rotation_arrow{'n'} = $id;
        }

        foreach my $rotation ( 'e', 's', 'w' ) {
            TkxPhotoRotateSimple::simple_photo_rotate(
                "$arrow_name-n", "$arrow_name-$rotation",
                $angle_for_direction{$rotation},
            );
            
            $id = $canvas->create_image(
                50, 50,  # Arbitrary values
                -image => "$arrow_name-$rotation",
                -tags  => [ 'rotation-arrows', 'game-items',
                            "$arrow_name-$rotation" ],
            );
            
            # TODO: This conditional is only necessary if I commit to
            # not using 'selected' arrows
            if ( $type eq 'enabled' || $type eq 'disabled') {
                $canvas->bind( $id, "<Button>",
                    [ \&rotation_arrow_clicked,
                      Tkx::Ev( "%x", "%y" ) ] );
            }

            # This is for keeping track of our enabled arrow IDs,
            # so that we can query them later (see
            # &rotation_arrow_clicked())
            if ( $type eq 'enabled' ) {
                $image_for_rotation_arrow{$rotation} = $id;
            }
        }
    }
    
    $canvas->lower( 'rotation-arrows', 'tiles' );
}

sub draw_link_selectors {
    # Part 1: First we create and draw the image of
    # the button for completing link selection.
    
    my $selector_name = 'Link-selection-complete';
    my $graphic_path = "$graphics_dir/$selector_name.gif";
    
    die "Graphic [$graphic_path.gif] not found!"
        if ( !( -e $graphic_path ) );
    
    Tkx::image_create_photo( $selector_name,
                             -file => $graphic_path );
    
    $link_selection_complete_id = $canvas->create_image(
        50, 50,  # Arbitrary values
        -image => $selector_name,
        -tags  => [ 'link-selectors', 'game-items' ],
    );
    
    $canvas->lower( 'link-selectors', 'tiles' );

    $canvas->bind( 'link-selectors', "<Button>", # Yes, all link selectors
                   [ \&link_selector_clicked,
                     Tkx::Ev( "%x", "%y" ) ] );

    # Part 2: Now we create the images for moving
    # shared links.  We do not draw the images here.
    # That is done on-the-fly whenever link-play-mode
    # is activated, since the number of selector
    # graphics depends on the number of shared links
    # at that moment.
    
    my %flip_axis_for = (
        '1L' => 'y',
        '2L' => 'xy',
        '2R' => 'x',
    );
    
    # TODO: Do we need the "plus-disabled" button?
    foreach my $type ( 'plus-enabled', 'plus-disabled',
                       'minus-enabled', 'minus-disabled' ) {
        $selector_name = "Link-$type";
        $graphic_path = "$graphics_dir/$selector_name.gif";
        
        die "Graphic [$graphic_path.gif] not found!"
            if ( !( -e $graphic_path ) );
        
        Tkx::image_create_photo( "$selector_name.1R",
                                 -file => $graphic_path );

        foreach my $flip_code ( keys %flip_axis_for ) {
            my $flip_axis = $flip_axis_for{$flip_code};
            
            TkxPhotoRotateSimple::simple_photo_flip(
                "$selector_name.1R", "$selector_name.$flip_code",
                $flip_axis );
        }
    }
}

sub tile_xy_to_coords {
   my ( $x, $y ) = @_;
   my $canvas_x = $preferences{'grid'}->{'TILE-SIZE'}*($x - 1)
       + $preferences{'grid'}->{'TILE-SIZE'}/2 + 1;
   my $canvas_y = $preferences{'grid'}->{'TILE-SIZE'}*($y_tiles - $y)
       + $preferences{'grid'}->{'TILE-SIZE'}/2 + 1;
   return ( $canvas_x, $canvas_y );
}

sub coords_to_tile_xy {
   my ( $canvas_x, $canvas_y ) = @_;
   my $x = int( $canvas_x / $preferences{'grid'}->{'TILE-SIZE'} ) + 1;
   my $y = int( 9 - ( $canvas_y / $preferences{'grid'}->{'TILE-SIZE'} ) );
   return ( $x, $y );
}

sub gamepiece_mod_clicked {
   gamepiece_clicked( 2, @_ );
}

sub gamepiece_index_at_cursor {
   my ( $canvas_x, $canvas_y, $graphics_ref, $skip_index ) = @_;
   # $skip_index is included to account for the scenario where a
   # gamepiece is grabbed, and a mouse-dragged event occurs over
   # the spot where it used to be (and the board thinks it still is)
   
   my $image_x = $canvas_x % $preferences{'grid'}->{'TILE-SIZE'};
   my $image_y = $canvas_y % $preferences{'grid'}->{'TILE-SIZE'};
   my $index;

   for( my $i = $#{ $graphics_ref }; $i >= 0; $i-- ) {
      my $image = $canvas->itemcget( $graphics_ref->[$i], '-image' );

      # How in the seven hells am I supposed to call this the "proper" way?
      my $is_transparent = Tkx::i::call( $image, 'transparency', 'get',
         $image_x, $image_y );

      if ( !$is_transparent ) {
         # We may have been told to ignore this index
         if ( defined $skip_index ) {
             next if ( $i == $skip_index );
         }

         # Break the loop.  We iterate from top-most to bottom-most graphic,
         # so there's no sense in checking the layers underneath.
         $index = $i;
         last;
      }
   }
   ( defined $index ) ? return $index : return -1;
}

sub gamepiece_clicked {
   return if ( $game_mode != $MOVE_PLAY_MODE );
   
   my ( $button, $canvas_x, $canvas_y ) = @_;
   my ( $x, $y ) = coords_to_tile_xy( $canvas_x, $canvas_y );

   my $tile = $board->convert( "$x,$y", 'tile' );
   my @graphics = @{ $board->get_tile_contents( $tile, 'graphics' ) };

   my $index = gamepiece_index_at_cursor( $canvas_x, $canvas_y, \@graphics );
   return if ( $index == -1 );  # Background of gamepiece was clicked

   my @legal_actions        = $board->legal_actions( $tile, $index );
   my @illegal_actions      = $board->illegal_actions( $tile, $index );
   my @proxy_movement_space = $board->proxy_movement_space( $tile, $index );

   foreach my $actions_arrayref ( \@legal_actions, \@illegal_actions ) {
      foreach my $action_ref ( @{ $actions_arrayref } ) {
         my ( $target_tile, $type ) = @{ $action_ref }{ 'target-tile', 'type' };
         
         # Now we filter our moves to reflect which mouse button was pressed.
         # Left-click shows moves/captures.  Right-click shows shots.
         if ( $button == $L_MOUSE ) {
            next if ( $type eq 'shot' );
         }
         if ( $button == $M_MOUSE || $button == $R_MOUSE ) {
            next if ( $type eq 'move' || $type eq 'capture' );
         }

         # Color code valid/invalid tiles
         $type .= ( $actions_arrayref == \@legal_actions )
            ? '-valid' : '-invalid';

         $canvas->addtag( $type, 'withtag' => $target_tile );
      }
   }

   # Color code movement fields for carrier units
   foreach my $proxy_tile ( @proxy_movement_space ) {
      $canvas->addtag( 'move-field', 'withtag' => $proxy_tile );
   }

   # Update the cursor to reflect the intended action
   my $cursor = ( $button == 1 ) ? $preferences{'cursors'}->{'MOVE'}
       : $preferences{'cursors'}->{'SHOT'};
   $canvas->configure( -cursor => $cursor );

   # We define the selection, so that the user can drag the gamepiece
   %selection = (
      'tile'          => $tile,
      'index'         => $index,
      'graphic'       => $graphics[$index],
      'start-x'       => $x,
      'start-y'       => $y,
      'legal-actions' => \@legal_actions,
      'button'        => $button,
      );
   
   paint_tiles();
}

sub gamepiece_dragged {
   return if ( $game_mode != $MOVE_PLAY_MODE );
   return if ( !%selection );

   my ( $canvas_x, $canvas_y ) = @_;
   my ( $x, $y ) = coords_to_tile_xy( $canvas_x, $canvas_y );
   my $target_tile = $board->convert( "$x,$y", 'tile' );
   my @target_graphics = @{ $board->get_tile_contents(
       $target_tile, 'graphics' ) };
   my ( $tile, $index, $button )
       = @selection{'tile', 'index', 'button'};

   # We have tile, index, and target-tile.  We just need
   # target-index and type, and then we can find our action
   my ( $target_index, $type, $action );

   # When we pick up a gamepiece and drag over the area where the graphic
   # used to be (but the board still thinks is there), we want the GUI to
   # act like the gamepiece graphic is not there.  So we add a skip_index
   # value to our gamepiece_index_at_cursor function call.
   my $skip_index = ( $tile eq $target_tile ) ? $index : undef;
   $target_index = gamepiece_index_at_cursor(
       $canvas_x, $canvas_y, \@target_graphics, $skip_index );

   # First we move the gamepiece graphic, if necessary
   if ( $button == $L_MOUSE ) {
      # Move graphic to cursor location
      $canvas->coords( $selection{'graphic'}, $canvas_x, $canvas_y );
   }

   # Next we check our drag event cache to see if we even
   # need to proceed
   my ( $cached_target_tile, $cached_target_index )
       = @selection{'target-tile', 'target-index'};
   if ( defined $cached_target_tile ) {
       if ( $target_tile eq $cached_target_tile &&
                $target_index == $cached_target_index ) {
           return;
       }

       # Since we know we have a cache, this is a good time to revert
       # any highlighting that did in previous drag events
       if ( defined $selection{'target-tile-color'} ) {
           $canvas->itemconfigure( $cached_target_tile,
                 -fill => $selection{'target-tile-color'} );
           $selection{'target-tile-color'} = undef;
       }
       if ( defined $selection{'target-index-graphic'} ) {
           $canvas->itemconfigure(
               $target_graphics[ $selection{'target-index'} ],
               -image => $selection{'target-index-graphic'} );
           $selection{'target-index-graphic'} = undef;
       }
   }

   # The target index for a move or rotation action is -1.
   # Careful!  It used to be 0, which was confusing, because
   # 0 is a valid capture/shot index.
   if ( $target_index != -1 ) {
       if ( $button == $L_MOUSE ) {
           $type = 'capture';
       }
       if ( $button == $M_MOUSE || $button == $R_MOUSE ) {
           $type = 'shot';
       }
   }
   if ( $target_index == -1 && $button == $L_MOUSE ) {
       if ( $tile eq $target_tile ) {
           $type = 'rotation';
       }
       else {
           $type = 'move';
       }
   }

   if ( defined $type ) {
       # Grep for the legal action that we are looking for!
       # If not found, set $action = undef.
       my @actions = grep {
           $_->type() eq $type
              && $_->target_tile() eq $target_tile
              && $_->target_index == $target_index;
       } @{ $selection{'legal-actions'} };

       $action = $actions[-1];
   }

   # Here we implement some very important highlighting.  The user
   # can drag gamepices wherever they want, and can only distinguish
   # betweem legal and illegal actions by the presence or absence
   # of highlighting.
   if ( defined $action ) {
       if ( $type eq 'move' || $type eq 'rotation' ) {
           $selection{'target-tile-color'} = $canvas->itemcget(
               $target_tile, '-fill' );
           $canvas->itemconfigure(
               $target_tile,
               -fill => $preferences{'colors'}->{'SELECTION'} );
       }
       
       if ( $type eq 'capture' || $type eq 'shot' ) {
           my $target_graphic = $canvas->itemcget(
               $target_graphics[$target_index], '-image' );
           $selection{'target-index-graphic'} = $target_graphic;
           $target_graphic =~ s{-P\d}{-selected};

           $canvas->itemconfigure(
               $target_graphics[ $target_index ],
               -image => $target_graphic );
       }       
   }
   
   # Note that, at this point, the action may be undefined.
   # That's fine.  That is how the code will know that the
   # action was illegal.
   # TODO: Do we need target-tile and target-index anymore?
   #  Technically, we can derive these from $action now.
   @selection{'target-tile', 'target-index', 'action'}
       = ( $target_tile, $target_index, $action );
}

sub gamepiece_released {
   return if ( $game_mode != $MOVE_PLAY_MODE );
   return if ( !%selection );

   my ( $button, $canvas_x, $canvas_y ) = @_;
   my ( $x, $y ) = coords_to_tile_xy( $canvas_x, $canvas_y );

   my ( $action, $graphic, $start_x, $start_y )
       = @selection{ 'action', 'graphic', 'start-x', 'start-y' };

   # We don't need those tile tags anymore
   reset_tile_colors();

   # Reset the cursor
   $canvas->configure( -cursor => $preferences{'cursors'}->{'STANDARD'} );

   # Abort if the action is illegal,
   # and put the graphic back where we found it
   if ( !defined $action ) {
       $canvas->coords( $graphic, tile_xy_to_coords( $start_x, $start_y ) );

       post_move_cleanup();
       return;
   }
   
   # What happens next depends on what other input we need from the
   # user.  Are there mulitple possible directions?  Are there any
   # shared links?
   if ( $action->possible_directions() > 1 ) {
       setup_rotation_play_mode();
       # Note that the rotation functions will also query
       # "shared_links()", so we haven't forgotten about
       # units that require both rotation and link input.
   }
   elsif ( $action->shared_links() > 0 ) {
       setup_link_play_mode();
   }
   else {
       # No shared links or multiple directions
       apply_board_action();
   }
}

## Set target_tile or target_direction to undefined
## to disable that mode
sub snap_graphic_to_tile {
    my ( $graphic, $target_tile, $target_direction ) = @_;
    
    # Move the graphic, if requested
    if ( defined $target_tile ) {
        my ( $target_tile_x, $target_tile_y )
            = split m{,}, $board->convert( $target_tile, 'xy' );
        
        my ( $canvas_x, $canvas_y ) = tile_xy_to_coords(
            $target_tile_x, $target_tile_y );
        
        $canvas->coords( $graphic, $canvas_x, $canvas_y );
    }
    
    # Rotate the graphic, if requested
    if ( defined $target_direction ) {
        my $image = $canvas->itemcget( $graphic, '-image' );
        $image =~ s{-[nsew]$}{-$target_direction};
        
        $canvas->itemconfigure(
            $graphic,
            -image => $image );
    }
    
    # Raise it above all other gamepiece graphics
    $canvas->raise( $graphic, 'gamepieces' );
}

sub setup_rotation_play_mode {
    $game_mode = $ROTATION_PLAY_MODE;
    
    my ( $action, $graphic ) = @selection{'action', 'graphic'};
    my $target_tile = $action->target_tile();
    my @possible_directions = $action->possible_directions();
    
    snap_graphic_to_tile( $graphic, $target_tile, undef );
    
    foreach my $direction ( 'n', 'e', 's', 'w' ) {
        my $arrow_image = "Arrow-";
        if ( grep m{$direction}, @possible_directions ) {
            $arrow_image .= "enabled-$direction";
        }
        else {
            $arrow_image .= "disabled-$direction";
        }

        snap_graphic_to_tile( $arrow_image, $target_tile, undef );
    }
}

sub rotation_arrow_clicked {
    my ( $canvas_x, $canvas_y ) = @_;
    my $action = $selection{'action'};
    my @possible_directions = $action->possible_directions();

    # The key here is that we are obtainining a list of enabled-arrow
    # IDs in order of appearance in @possible_directions.
    my @possible_images = @image_for_rotation_arrow{@possible_directions};

    my $index = gamepiece_index_at_cursor(
        $canvas_x, $canvas_y, \@possible_images );
    
    # If the user clicks on a disabled rotation arrow,
    # or somewhere in the background, the $index is
    # negative one.  Act like nothing happened.
    return if ( $index == -1 );
    
    my $direction = $possible_directions[$index];
    
    eval {
        $action->set_direction( $direction );
    };
    raise_error( $@ ) if $@;

    # We are finished with the rotation arrows
    $canvas->lower( 'rotation-arrows', 'tiles' );
    
    # Now we take care of those units that have shared links
    # as well as multiple directions.  We HAVE to query
    # shared_links() AFTER setting the direction, as that
    # may change the number of allowed shared-links.
    ( $action->shared_links() > 0 ) ?
        setup_link_play_mode() : apply_board_action();
}

sub setup_link_play_mode {
    $game_mode = $LINK_PLAY_MODE;
    
    my ( $action, $graphic ) = @selection{'action', 'graphic'};
    my $target_tile = $action->target_tile();
    my $direction = $action->direction();
    $direction = 'n' if ( !defined $direction );
    my @shared_links = $action->shared_links();
    my @unshared_links = $action->unshared_links();
    my $carrier_tile = $action->target_tile();
    my @possible_directions = $action->possible_directions();
    
    # It looks nicer to have the carrier turn before letting
    # us choose our links.
    snap_graphic_to_tile( $graphic, $target_tile, $direction );
    
    $selection{'upgraded-links'} = [];
    
    %link_selector_graphics_at = (
        $carrier_tile => [ $link_selection_complete_id ],
    );
    %link_selector_data = ();
    
    snap_graphic_to_tile( $link_selection_complete_id,
                      $action->target_tile(), undef );
    $canvas->raise( $link_selection_complete_id, 'game-items' );
    
    foreach my $link ( @shared_links ) {
        my ( $tile, $index ) = split m{\.}, $link, 2;
        $index = 0 if ( !defined $index );
        my $link_photo = $board->get_tile_contents_for_index(
            $tile, $index, 'graphic' );
        my $link_image = $canvas->itemcget( $link_photo, '-image' );
        my ( $flip_code ) = ( $link_image =~ m{\.([12][LR])-} );
        my $destination = $action->link_destination(
            $link, $direction );
        my ( $destination_tile, $rest ) = split m{\.}, $destination, 2;
        
        my $plus_id = $canvas->create_image(
            50, 50,  # Arbitrary values
            -image => "Link-plus-enabled.$flip_code",
            -tags => [ 'link-selectors', 'enabled-selectors',
                       'temporary-link-selectors', 'game-items' ],
        );
        my $minus_id = $canvas->create_image(
            50, 50,  # Arbitrary values
            -image => "Link-minus-enabled.$flip_code",
            -tags => [ 'link-selectors', 'enabled-selectors',
                       'temporary-link-selectors', 'game-items' ],
        );
        
        snap_graphic_to_tile( $plus_id, $tile, undef );
        $canvas->raise( $plus_id, 'game-items' );
        snap_graphic_to_tile( $minus_id, $destination_tile, undef );
        $canvas->lower( $minus_id, 'tiles' );
        
        $link_selector_data{$plus_id}
            = [ $link_photo, $destination_tile, $minus_id, $link, 1 ];
        $link_selector_data{$minus_id}
            = [ $link_photo, $tile, $plus_id, $link, 0 ];

        if ( !defined $link_selector_graphics_at{$tile} ) {
            $link_selector_graphics_at{$tile} = [];
        }
        push @{ $link_selector_graphics_at{$tile} }, $plus_id;
        
        if ( !defined $link_selector_graphics_at{$destination_tile} ) {
            $link_selector_graphics_at{$destination_tile} = [];
        }
        # We don't push the minus-graphic into the graphics array,
        # since it is not visible at this time.
    }
    
    foreach my $link ( @unshared_links ) {
        my ( $tile, $index ) = split m{\.}, $link, 2;
        $index = 0 if ( !defined $index );
        my $link_photo = $board->get_tile_contents_for_index(
            $tile, $index, 'graphic' );
        my $link_image = $canvas->itemcget( $link_photo, '-image' );
        my ( $flip_code ) = ( $link_image =~ m{\.([12][LR])-} );
        my $destination = $action->link_destination(
            $link, $direction );
        my ( $destination_tile, $rest ) = split m{\.}, $destination, 2;
        
        my $disabled_id = $canvas->create_image(
            50, 50,  # Arbitrary values
            -image => "Link-minus-disabled.$flip_code",
            -tags => [ 'link-selectors', 'temporary-link-selectors',
                   'game-items' ],
        );

        snap_graphic_to_tile( $link_photo, $destination_tile, undef );
        snap_graphic_to_tile( $disabled_id, $destination_tile, undef );
        $canvas->raise( $disabled_id, 'game-items' );
        
        if ( !defined $link_selector_graphics_at{$tile} ) {
            $link_selector_graphics_at{$tile} = [];
        }
        # We don't push the graphics ID into the graphics array,
        # because it represents a disabled option.
    }
}

sub link_selector_clicked {
    my ( $canvas_x, $canvas_y ) = @_;
    my ( $x, $y ) = coords_to_tile_xy( $canvas_x, $canvas_y );
    my $tile = $board->convert( "$x,$y", 'tile' );
    my $graphics_ref = $link_selector_graphics_at{$tile};
    my $index = gamepiece_index_at_cursor(
        $canvas_x, $canvas_y, $graphics_ref );
    
    # If the user clicks on a disabled link-selector,
    # or somewhere in the background, the $index is
    # negative one.  Act like nothing happened.
    return if ( $index == -1 );
    
    my $selector_id = $graphics_ref->[$index];
    
    if ( $selector_id != $link_selection_complete_id ) {
        my ( $link_photo, $destination_tile, $alternate_selector_id,
             $link, $is_plus ) = @{ $link_selector_data{$selector_id} };
        
        splice( @{ $graphics_ref }, $index, 1 );
        
        snap_graphic_to_tile( $link_photo, $destination_tile, undef );
        $canvas->lower( $selector_id, 'tiles' );
        $canvas->raise( $alternate_selector_id, 'game-items' );
        push @{ $link_selector_graphics_at{$destination_tile} },
            $alternate_selector_id;

        if ( $is_plus ) {
            push @{ $selection{'upgraded-links'} }, $link;
        }
        else {
            @{ $selection{'upgraded-links'} } = grep { $_ ne $link }
                @{ $selection{'upgraded-links'} };
        }
    }
    else {
        my $action = $selection{'action'};
        foreach my $link ( @{ $selection{'upgraded-links'} } ) {
            eval {
                $action->upgrade_link( $link );
            };
            raise_error( $@ ) if $@;
        }
        
        $canvas->delete( 'temporary-link-selectors' );
        $canvas->lower( $link_selection_complete_id, 'tiles' );
        apply_board_action( $action );
    }
}

sub apply_board_action {
   my $action = $selection{'action'};
   
   # The following method call returns an array detailing
   # the results of the action, which we may make use of
   # some day (but not today).
   eval {
       $board->apply_action( $action );
   };
   raise_error( $@ ) if $@;
   
   post_move_cleanup();
}

sub post_move_cleanup {
   $game_mode = $MOVE_PLAY_MODE;
   
   # Undefine selection so as not to confuse gamepiece_dragged()
   %selection = ();
}

sub raise_error {
   my $error = (shift)." This program will now exit.";

   Tkx::tk___messageBox(
      -title => 'Fatal Error',
      -type => 'ok',
      -message => $error,
      -icon => 'error',
      );

   exit_program();
}

sub exit_program {
   $top->g_destroy() if defined $top;
   exit;
}

